ОТДЕЛ editdemo;

ИСПОЛЬЗУЕТ
  Strings, Windows;
ПОСТ
  AppName = 'EditDemo';
ВИД
  TFileName = РЯД [0..Max_Path] ИЗ ЗНАК;
ПЕР
  AMessage             :Msg;
  HWindow,HStatus,HEdit:HWnd;
  TheFont              :HFont;
  TheLogFont           :TLogFont;
  TheColor             :DWORD;
  FileName             :TFileName;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА SetStatusText(Num:ЦЕЛ; Text-:string);
ПЕР
  StatText:РЯД [0..255] ИЗ ЗНАК;
УКАЗ
  ЕСЛИ Num = 0 ТО  
    StatText[0]:=' '  (* Add space to text in first item *)
  ИНАЧЕ 
    StatText[0]:=#9;  (* Center the rest *)
  КОН;
  StrPCopy(@StatText[1],Text);
  SendMessage(HStatus,SB_SETTEXT,WPARAM(Num),LPARAM(@StatText));
КОН SetStatusText;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА SelectFile(FName-:TFileName; Open+:КЛЮЧ):КЛЮЧ;
ПОСТ
  Filter:PChar = 'Text files (*.txt)'#0'*.txt'#0'All files (*.*)'#0'*.*'#0#0;
  Ext   :PChar = 'txt';
ПЕР
  NameRec:OpenFileName;
УКАЗ
  FillChar(NameRec,SizeOf(NameRec),0);
  FName[0]:=#0;
  ДЛЯ NameRec ВЫП
    LStructSize:=SizeOf(NameRec);
    HWndOwner :=HWindow;
    LpStrFilter:=Filter;
    LpStrFile :=@FName;
    NMaxFile  :=Max_Path;
    Flags     :=OFN_Explorer ИЛИ OFN_HideReadOnly;
    ЕСЛИ Open ТО  
      Flags:=Flags ИЛИ OFN_FileMustExist
    КОН;
    LpStrDefExt:=Ext
  КОН;
  ЕСЛИ Open ТО  
    ВОЗВРАТ GetOpenFileName(@NameRec)
  ИНАЧЕ 
    ВОЗВРАТ GetSaveFileName(@NameRec)
  КОН
КОН SelectFile;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА SaveText;
ПЕР
  Len  :ЦЕЛ;
  P    :PChar;
  F    :File;
  FName:TFileName;
УКАЗ
  ЕСЛИ SelectFile(FName,False) ТО  
      Assign(F,@FName);
      Rewrite(F,1);
      Len:=GetWindowTextLength(HEdit);
      GetMem(P,Len+1);
      P[Len]:=#0;
    ЕСЛИ Len>0 ТО  
        GetWindowText(HEdit,P,Len+1);
        BlockWrite(F,P^,Len);
    КОН;
      Close(F);
      FreeMem(P,Len+1);
      StrCopy(FileName,FName);
      SetStatusText(0,StrPas(FileName));
      SetStatusText(1,'');
      SendMessage(HEdit,EM_SetModify,0,0);
  КОН
КОН SaveText;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА AskSave;
ПОСТ
  BoxType = MB_IconQuestion ИЛИ MB_YesNo;
УКАЗ
  ЕСЛИ SendMessage(HEdit,EM_GetModify,0,0) # 0 ТО  
    ЕСЛИ MessageBox(HWindow,'Save text?','Edited',BoxType)=IdYes ТО  
          SaveText;
    КОН;
  КОН
КОН AskSave;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА LoadText;
ПЕР
  F    :File;
  Len  :ЦЕЛ;
  P    :PChar;
УКАЗ
  AskSave;
  ЕСЛИ SelectFile(FileName,True) ТО  
      Assign(F,@FileName);
      Reset(F,1);
      Len:=FileSize(F);
      GetMem(P,Len+1);
      P[Len]:=#0;
    ЕСЛИ Len>0 ТО
        BlockRead(F,P^,Len)
    КОН;
      Close(F);
      SetWindowText(HEdit,P);
      SendMessage(HEdit,EM_SetModify,0,0);
      FreeMem(P,Len+1);
      SetStatusText(0,StrPas(FileName));
      SetStatusText(1,'');
  КОН
КОН LoadText;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА NewText;
ПОСТ
  Empty:PChar = '';
УКАЗ
  AskSave;
  FileName:='Unsaved';
  SetStatusText(0,StrPas(FileName));
  SendMessage(HEdit,WM_SetText,1,LRESULT(Empty));
  SendMessage(HEdit,EM_SetModify,0,0);
КОН NewText;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА SelectFont;
ПЕР
  ChooseFontRec:TChooseFont;
УКАЗ
  ДЛЯ ChooseFontRec ВЫП
      lStructSize  :=SizeOf(ChooseFontRec);
      hwndOwner    :=HWindow;
      hDC          :=0;
      lpLogFont    :=@TheLogFont;
      iPointSize   :=0;
      Flags        :=CF_INITTOLOGFONTSTRUCT ИЛИ CF_SCREENFONTS ИЛИ CF_EFFECTS;
      rgbColors    :=TheColor;
      lCustData    :=0;
      lpfnHook     :=ПУСТО;
      lpTemplateName:=ПУСТО;
      hInstance    :=0;
      lpszStyle    :=ПУСТО;
      nFontType    :=0;
      nSizeMin     :=0;
      nSizeMax     :=0;
  КОН;
  ЕСЛИ ChooseFont(@ChooseFontRec) ТО  
      DeleteObject(TheFont);
      TheColor:=ChooseFontRec.rgbColors;
      TheFont:=CreateFontIndirect(@TheLogFont);
      SendMessage(HEdit,WM_SETFONT,WPARAM(TheFont),1);
  КОН
КОН SelectFont;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА WindowProc (
         Window:HWnd;
         AMessage:UINT;
         WParam:WPARAM;
         LParam:LPARAM):LRESULT;   stdcall;  export;
ПЕР
  R       :rect;
  StatH   :LONG;
  NrMenu  :ЦЕЛ;
  NotiCode:ЦЕЛ;
УКАЗ
  WindowProc:=0;
  ВЫБРАТЬ AMessage ИЗ
  | wm_Close:
        AskSave
  | wm_Destroy:
        PostQuitMessage (0);
        ВОЗВРАТ
  | wm_SetFocus:
        SetFocus(HEdit)
  | WM_EraseBkgnd:
        ВОЗВРАТ(1)
  | wm_Size:
        GetClientRect(HStatus,@R);
        StatH:=R.Bottom-R.Top;
        GetClientRect(Window,@R);
        MoveWindow(HEdit,0,0,R.Right,R.Bottom-StatH,False);
        MoveWindow(HStatus,0,R.Bottom-StatH,R.Right,R.Bottom,False)
  | wm_Command:
        NotiCode:=HiWord(WParam);
        ВЫБРАТЬ NotiCode ИЗ
          en_Change:     (*// Editor has changed *)
            ЕСЛИ SendMessage(HEdit,EM_GetModify,0,0) # 0 ТО  
                SetStatusText(1,'Modified')
            ИНАЧЕ 
                SetStatusText(1,'');
            КОН
        ИНАЧЕ                    (*// Menu item *)
            NrMenu:=LoWord(WParam);
            ВЫБРАТЬ NrMenu ИЗ
            | 101:NewText
            | 102:LoadText
            | 103:SaveText
            | 104:PostMessage(Window,WM_Close,0,0)
            | 201:SendMessage(HEdit,WM_Undo,0,0)
            | 202:SendMessage(HEdit,WM_Cut,0,0)
            | 203:SendMessage(HEdit,WM_Copy,0,0)
            | 204:SendMessage(HEdit,WM_Paste,0,0)
            | 301:SelectFont
            | 401:MessageBox(Window,
                            'Help',
                            'НЕ implemented',
                             MB_OK ИЛИ MB_IconInformation)
            КОН
        КОН
  | wm_CtlColorEdit:
        SetTextColor(WParam,TheColor);
        ВОЗВРАТ GetSysColorBrush(COLOR_WINDOW)
  КОН;
  ВОЗВРАТ DefWindowProc(Window,AMessage,WParam,LParam)
КОН WindowProc;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА WinRegister:КЛЮЧ;
ПЕР
  WindowClass:WndClass;
УКАЗ
  ДЛЯ WindowClass ВЫП
      Style       :=cs_hRedraw ИЛИ cs_vRedraw;
      lpfnWndProc :=WndProc(@WindowProc);
      cbClsExtra  :=0;
      cbWndExtra  :=0;
      hInstance   :=system.MainInstance;
      hIcon       :=LoadIcon (0,idi_Application);
      hCursor     :=LoadCursor (0,idc_Arrow);
      hbrBackground:=GetStockObject(GRAY_BRUSH);
      lpszMenuName:=ПУСТО;
      lpszClassName:=AppName;
  КОН;
  ВОЗВРАТ (RegisterClass(WindowClass) # 0)
КОН WinRegister;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА EditCreate(ParentWindow,Status:HWnd):HWnd;
ПОСТ
  CS_Start = WS_Child ИЛИ WS_HScroll ИЛИ WS_VScroll ИЛИ ES_MultiLine ИЛИ ES_Left;
  CS_Ex    = WS_EX_ClientEdge;
  EdiTText:PChar = '';
ПЕР
  HEdit:HWND;
  R    :TRect;
  StatH:Word;
УКАЗ
  GetClientRect(Status,@R);
  StatH:=R.Bottom-R.Top;
  GetClientRect(ParentWindow,@R);
  HEdit:=CreateWindowEx (CS_Ex,
                        'EDIT',
                         EditText,CS_Start,0,0,
                         R.Right-R.Left,
                         R.Bottom-R.Top-StatH,
                         ParentWindow,0,
                         MainInstance,ПУСТО);
  ЕСЛИ HEdit # 0 ТО       (*// Set Courier new as default font *)
    ДЛЯ TheLogFont ВЫП
          lfHeight       :=0;   (*//  Default logical height ИЗ font *)
          lfWidth        :=0;   (*//  Default logical average character width *)
          lfEscapement   :=0;   (*//  angle ИЗ escapement *)
          lfOrientation  :=0;          (*//  base-line orientation angle *)
          lfWeight       :=FW_NORMAL;  (*//  font weight *)
          lfItalic       :=0;          (*//  italic attribute flag *)
          lfUnderline    :=0;          (*//  underline attribute flag *)
          lfStrikeOut    :=0;                (*//  strikeout attribute flag *)
          lfCharSet      :=DEFAULT_CHARSET;  (*//  character set identifier *)
          lfOutPrecision :=OUT_DEFAULT_PRECIS;  (*//  output precision *)
          lfClipPrecision:=CLIP_DEFAULT_PRECIS; (*//  clipping precision *)
          lfQuality      :=DEFAULT_QUALITY;     (*//  output quality *)
          lfPitchAndFamily:=DEFAULT_PITCH;      (*//  pitch И family *)
          Strcopy(lfFaceName,'Courier New'); (*//  pointer to typeface name string *)
    КОН;
      TheColor:=GetSysColor(COLOR_WINDOWTEXT);
      TheFont:=CreateFontIndirect(@TheLogFont);
      SendMessage(HEdit,WM_SETFONT,WPARAM(TheFont),1);
      ShowWindow(Hedit,SW_Show);
      UpdateWindow(HEdit);
  КОН;
  ВОЗВРАТ HEdit
КОН EditCreate;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА WinCreate:HWnd;

ПЕР hWindow:HWnd;
    Menu   :hMenu;
    SubMenu:hMenu;
УКАЗ
  hWindow:=CreateWindow (AppName,
                        'EditDemo',
                         ws_OverlappedWindow,
                         cw_UseDefault,
                         cw_UseDefault,
                         cw_UseDefault,
                         cw_UseDefault,0,0,MainInstance,ПУСТО);
  ЕСЛИ hWindow # 0 ТО  
      Menu:=CreateMenu;
      SubMenu:=CreateMenu;
      AppendMenu(Submenu,MF_STRING,101,'&New...');
      AppendMenu(Submenu,MF_STRING,102,'&Open...');
      AppendMenu(Submenu,MF_STRING,103,'&Save...');
      AppendMenu(Submenu,MF_SEPARATOR,0,ПУСТО);
      AppendMenu(SubMenu,MF_String,104,'E&xit');
      AppendMenu(Menu,MF_POPUP,SubMenu,'&File');
      SubMenu:=CreateMenu;
      AppendMenu(SubMenu,MF_String,201,'&Undo'#8'Ctrl+Z');
      AppendMenu(Submenu,MF_SEPARATOR,0,ПУСТО);
      AppendMenu(SubMenu,MF_String,202,'&Cut'#8'Ctrl+X');
      AppendMenu(SubMenu,MF_String,203,'&Copy'#8'Ctrl+C');
      AppendMenu(SubMenu,MF_STRING,204,'&Paste'#8'Ctrl+V');
      AppendMenu(Menu,MF_POPUP,SubMenu,'&Edit');
      SubMenu:=CreateMenu;
      AppendMenu(SubMenu,MF_String,301,'&Font...');
      AppendMenu(Menu,MF_POPUP,SubMenu,'&Options');
      AppendMenu(Menu,MF_STRING,401,'&Help');
      SetMenu(hWindow,menu);
      ShowWindow(hWindow,SW_Show);
      UpdateWindow(hWindow);
  КОН;
  ВОЗВРАТ hWindow
КОН WinCreate;

(*────────────────────────────────────────────────────────────────────────────*)
ЗАДАЧА StatusCreate (parent:hwnd):HWnd;
ПЕР
  AWnd  :HWnd;
  Edges :РЯД [1..2] ИЗ ЦЕЛ;
УКАЗ
  FileName:='Unsaved';
  AWnd:=CreateStatusWindow(WS_CHILD ИЛИ WS_VISIBLE,FileName,Parent,$7712);
                      (*// Create items: *)
  ЕСЛИ AWnd # 0 ТО
      Edges[1]:=400;
      Edges[2]:=500;
      SendMessage(AWnd,SB_SETPARTS,2,LPARAM(@Edges));
  КОН;
  ВОЗВРАТ AWnd
КОН StatusCreate;

(*────────────────────────────────────────────────────────────────────────────*)
УКАЗ
  ЕСЛИ НЕ WinRegister ТО  
      MessageBox(0,'Register failed',ПУСТО,mb_Ok);
  ИНАЧЕ 
      hWindow:=WinCreate;
    ЕСЛИ ЦЕЛ(hWindow) = 0 ТО  
          MessageBox(0,'WinCreate failed',ПУСТО,MB_OK);
    ИНАЧЕ 
          HStatus:=statuscreate(hwindow);
          HEdit:=EditCreate(HWindow,HStatus);
          SetFocus(HEdit);
      ПОКА GetMessage(@AMessage,0,0,0) ВЫП
              TranslateMessage(AMessage);
              DispatchMessage(AMessage);
      КОН;
          DeleteObject(TheFont);
      СТОП(AMessage.wParam);
    КОН
  КОН
КОН editdemo.

▲ Вопросы, замечания и предложения высылайте на atimopheyev@yahoo.com или Издателю Глагола: